home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form frmMenu
- Appearance = 0 'Flat
- AutoRedraw = -1 'True
- Caption = "Vertical Menu Columns Demo"
- ClientHeight = 4620
- ClientLeft = 3135
- ClientTop = 1965
- ClientWidth = 7365
- ForeColor = &H80000008&
- LinkTopic = "Form1"
- PaletteMode = 1 'UseZOrder
- ScaleHeight = 308
- ScaleMode = 3 'Pixel
- ScaleWidth = 491
- Begin VB.Menu mnuTwo
- Caption = "Two Level Menu"
- Begin VB.Menu mnuList1
- Caption = "Menu Item 1"
- Index = 0
- End
- Begin VB.Menu mnuPopUp
- Caption = "More Sub Menus"
- Begin VB.Menu mnuList4
- Caption = "Menu Item 1"
- Index = 0
- End
- End
- End
- Begin VB.Menu mnuThree
- Caption = "Three Level Menu"
- Begin VB.Menu mnuSub1
- Caption = "With Vertical Separator"
- Begin VB.Menu mnuList2
- Caption = "Menu Item 1"
- Index = 0
- End
- End
- Begin VB.Menu mnuSub2
- Caption = "Without Vertical Separator"
- Begin VB.Menu mnuList3
- Caption = "Menu Item 1"
- Index = 0
- End
- End
- End
- Attribute VB_Name = "frmMenu"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- ' demo project showing how to manipulate VB menus using the API
- ' by Bryan Stafford of New Vision Software
- - newvision@imt.net
- ' this demo is released into the public domain "as is" without
- ' warranty or guaranty of any kind. In other words, use at
- ' your own risk.
- ' API calls used
- Private Declare Function GetMenu& Lib "user32" (ByVal hwnd&)
- Private Declare Function GetSubMenu& Lib "user32" (ByVal hMenu&, ByVal nPos&)
- Private Declare Function GetMenuItemID& Lib "user32" (ByVal hMenu&, ByVal nPos&)
- Private Declare Function ModifyMenu& Lib "user32" Alias "ModifyMenuA" (ByVal hMenu&, _
- ByVal nPosition&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpString$)
- Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
- Private Sub Form_Load()
- ' It seems that there is a limit to the number of menus that may be added
- ' in any VB application. I discovered this by setting the number of menus
- ' in each menu array ever higher until I received an 'Out of Memory' error.
- ' The error occurred at 337 items between all three menu arrays. This does
- ' not take into account the other higher level menus in the application.
- ' position the form
- Move (Screen.Width \ 2) - (Width \ 2), 0
- Form_Paint ' Autoredraw is set to true so we need to call the form paint to draw the form text
- Const MF_BYPOSITION As Long = &H400& '<--** tells modifymenu to act on the menu at the specified position
- Const MF_MENUBARBREAK As Long = &H20& '<--** tells modifymenu to add another column with a vertical separator
- Const MF_MENUBREAK As Long = &H40& '<--** tells modifymenu to add another column without a vertical separator
- Const SM_CYFULLSCREEN As Long = 17& '<--** height of client area of a maximized window
- Const SM_CYMENU As Long = 15& '<--** height of menu
- Dim menuheight&, breakpoint&, menuhWnd&, submenuhWnd&, nextsubmenuhWnd&
- Dim i&, loopnum&, loopstr$, msg$
- ' get the client area height and divide it by the height of a menu
- ' to get the point where we need to *wrap* the menu to a new column
- menuheight = GetSystemMetrics(SM_CYMENU)
- breakpoint = (GetSystemMetrics(SM_CYFULLSCREEN) - menuheight) \ menuheight
- menuhWnd = GetMenu(hwnd) ' get the handle of the menu for *this* form
- submenuhWnd = GetSubMenu(menuhWnd, 0) ' get the handle of the first sub menu
- For i = 1 To 99 ' load the first menu array (rember, zero is already loaded)
- On Error GoTo TooManyMenus
- Load mnuList1(i)
- On Error GoTo 0
- mnuList1(i).Caption = "Menu Item " & CStr(i + 1)
- ' if we've reached the breakpoint then add a new column with
- If i Mod breakpoint = 0 Then ' a vertical bar the proper ID must be specified
- Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
- GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
- End If
- Next
-
- ' get the handle of the popup menu that is in the position
- submenuhWnd = GetSubMenu(submenuhWnd, i) ' at AFTER the menus we just loaded
- For i = 1 To 9 ' load the popup sub menu array of the first menu array (rember, zero is already loaded)
- On Error GoTo TooManyMenus
- Load mnuList4(i)
- On Error GoTo 0
- mnuList4(i).Caption = "Menu Item " & CStr(i + 1)
- ' if we've reached the breakpoint then add a new column with a vertical bar
- If i Mod 5 = 0 Then ' the proper ID must be specified
- Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
- GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
- End If
- Next
- submenuhWnd = GetSubMenu(menuhWnd, 1) ' get the sub menu of the second top level menu (position 1)
- nextsubmenuhWnd = GetSubMenu(submenuhWnd, False) ' get the first sub menu of the sub menu
- loopnum = 1 ' set variable for trapped errors
- For i = 1 To 99 ' load the second menu array (rember, zero is already loaded)
- On Error GoTo TooManyMenus
- Load mnuList2(i)
- On Error GoTo 0
- mnuList2(i).Caption = "Menu Item " & CStr(i + 1)
- ' if we've reached the breakpoint then add a new column with a vertical bar
- If i Mod breakpoint = 0 Then ' the proper ID must be specified
- Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
- GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
- End If
- Next
- nextsubmenuhWnd = GetSubMenu(submenuhWnd, 1) ' get the second sub menu of the sub menu
- loopnum = 2 ' set variable for trapped errors
- For i = 1 To 99 ' load the third menu array (rember, zero is already loaded)
- On Error GoTo TooManyMenus
- Load mnuList3(i)
- On Error GoTo 0
- mnuList3(i).Caption = "Menu Item " & CStr(i + 1)
- ' if we've reached the breakpoint then add a new column without a vertical bar
- If i Mod breakpoint = 0 Then ' the proper ID must be specified
- Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBREAK, _
- GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
- End If
- Next
- Exit Sub
- TooManyMenus:
- ' display message telling where the error occurred
- Select Case loopnum
- Case 0
- loopstr$ = "first"
- Case 1
- loopstr$ = "second"
- Case 2
- loopstr$ = "third"
- End Select
- msg$ = "Ran out of menu space while loading sub menu number " & CStr(i) & " in the " & loopstr$ & " loop."
- MsgBox msg$, 48, "ERROR!"
- On Error GoTo 0
- Exit Sub
- End Sub
- Private Sub Form_Paint()
- ' print the text on the form
- CurrentY = 70
- CurrentX = 40
- Print "This application demonstrates adding columns and vertical bars to Visual Basic menus."
- CurrentX = 40
- Print "Explore the menus on this form to see examples of how VB menus can be *extended*."
- Print
- Print
- CurrentX = 40
- Print "Developed by Bryan Stafford of New Vision Software
- and released into the public"
- CurrentX = 40
- Print "domain. This application is provided ""As Is"" with no guarantee or warranty of any"
- CurrentX = 40
- Print "kind. You may redistribute this application and the source code so long as no fee is "
- CurrentX = 40
- Print "charged and no changes have been made. All questions and comments are"
- CurrentX = 40
- Print "welcome by e-mail at: newvision@imt.net"
- End Sub
- Private Sub mnuList1_Click(index As Integer)
- ' report the menu that was chosen
- Dim msg$
- msg$ = "You chose item number " & CStr(index + 1) & " from the Two Level Menu"
- MsgBox msg$, 64, "Menu Columns Demo"
- End Sub
- Private Sub mnuList2_Click(index As Integer)
- ' report the menu that was chosen
- Dim msg$
- msg$ = "You chose item number " & CStr(index + 1) & " from the first sub menu of the Three Level Menu"
- MsgBox msg$, 64, "Menu Columns Demo"
- End Sub
- Private Sub mnuList3_Click(index As Integer)
- ' report the menu that was chosen
- Dim msg$
- msg$ = "You chose item number " & CStr(index + 1) & " from the second sub menu of the Three Level Menu"
- MsgBox msg$, 64, "Menu Columns Demo"
- End Sub
- Private Sub mnuList4_Click(index As Integer)
- ' report the menu that was chosen
- Dim msg$
- msg$ = "You chose item number " & CStr(index + 1) & " from the popup sub menu of the Two Level Menu"
- MsgBox msg$, 64, "Menu Columns Demo"
- End Sub
-